Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/v9n21.arc/DGWRYTE.PAS

Pascal/Delphi Source File | 1990-11-17 | 8KB | 237 lines

{
 ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
 █                                                                         █
 █        TITLE :      DGWRYTE.TPU                                         █
 █      PURPOSE :      Replacement for WriteLn.                            █
 █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   Written in Turbo Pascal, Version 5.5,                                 █
 █   with routines from TurboPower, Object Professional.                   █
 █                                                                         █
 █   Turbo Pascal is a product of Borland International.                   █
 █   Object Professional is a product of TurboPower Software.              █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   This is not public domain software.                                   █
 █   This software is copyright 1990, by David Gerrold.                    █
 █   Permission is hereby granted for personal use.                        █
 █                                                                         █
 █        The Brass Cannon Corporation                                     █
 █        9420 Reseda Blvd., #804                                          █
 █        Northridge, CA  91324-2932.                                      █
 █                                                                         █
 ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
                                                                            }
{ Compiler Directives ===================================================== }

{$A-}    {Switch word alignment off, necessary for cloning}
{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-}    {Variable range checking off}

{ Name ==================================================================== }

UNIT DgWryte;

{ Interface =============================================================== }

INTERFACE

USES
{ Object Professional Units }
  OpCrt;

{ Functions and Procedures ================================================ }

FUNCTION Binary (B : byte) : string;
{ Returns string showing bits set in B. }

PROCEDURE BlankLine (Row, Attr : byte);
{ writes a blank line to screen }

PROCEDURE FastCenterAbs (S : string;  Row, Attr : byte);
{ shell for FastWrite, writes centered text }

PROCEDURE FastFlushAbs (S : string;  Row, Attr : byte);
{ shell for FastWrite, writes text flush right }

PROCEDURE FlushKbd;
{ Flushes the keyboard buffer, including mouse clicks. }

PROCEDURE RulerLine (Y : byte);
{ puts a ruler on line Y }

PROCEDURE Wryte (S : string);
{ shell for Write }

PROCEDURE WryteLn (S : string);
{ shell for WriteLn }

{ ========================================================================= }
{ Implementation ========================================================== }

IMPLEMENTATION

{ ========================================================================= }
{ Binary ================================================================== }

FUNCTION Binary (B : byte) : string;
{ Returns string showing bits set in B. }

VAR
  Loop : byte;
  Temp : string;
  Ch   : char;

BEGIN
  Temp := '';
  Loop := 128;
    repeat
      if
        B and Loop = Loop
      then
        Ch := '1'
      else
        Ch := '0';
      Temp := Temp + Ch;
      Loop := Loop div 2;
    until
      Loop <= 0;
  Binary := Temp;
END;

{ BlankLine =============================================================== }

PROCEDURE BlankLine (Row, Attr : Byte);
BEGIN
  FastFill (ScreenWidth, ' ', Row, 1, Attr);
END;

{ FastFlushAbs  =========================================================== }

PROCEDURE FastCenterAbs (S : string;  Row, Attr : byte);
{ shell for FastWrite, writes centered text }

VAR
  Len : byte absolute S;

BEGIN
  FastWrite (S, Row, succ ((ScreenWidth - Len) div 2), Attr);
END;

{ FastFlushAbs  =========================================================== }

PROCEDURE FastFlushAbs (S : string;  Row, Attr : byte);
{ shell for FastWrite, writes text flush right }
VAR
  Len : byte absolute S;

BEGIN
  FastWrite (S, Row, ScreenWidth - pred (Len), Attr);
END;

{ FlushKbd ================================================================ }

PROCEDURE FlushKbd;
{ Flushes the keyboard buffer, including mouse clicks. }

VAR
  I : word;
BEGIN
  {$IFDEF UseMouse}
  while KeyOrButtonPressed do
    I := ReadKeyOrButton;
  {$ELSE}
  while KeyPressed do
    I := ReadKeyWord;
  {$ENDIF}
END;
{
  Identical to FlushKeyboard in Object Professional's TPUI unit.
}

{ RulerLine =============================================================== }

PROCEDURE RulerLine (Y : byte);
{ puts a ruler on line Y }

VAR
  Loop : byte;

BEGIN
  For Loop := 0 to 7 do
    FastWrite ('1234567890', Y, succ (Loop * 10), LightRed);
END;

{ Wryte =================================================================== }

PROCEDURE Wryte (S : string);
{
  The Turbo Pascal compiler generates extra code when it compiles a
  call to WriteLn.  This is because WriteLn must parse both strings
  and variables before it can write them.  Each call to the procedure
  carries the baggage of the parsing routines.

  WryteLn is a shell procedure for WriteLn.

  By having only one call to WriteLn in an entire program and calling
  it through a shell procedure, the program will trade some speed for
  code size -- but if speed is really critical, you should be using
  Object Professional's FastWrite procedures instead.

  Multiple variables can still be passed by concatenating them:
  WryteLn ('The time is now: ' + TimeStr + '.');
}

BEGIN
  Write (S);
END;

{ WryteLn ================================================================= }

PROCEDURE WryteLn (S : string);
{
  The Turbo Pascal compiler generates extra code when it compiles a
  call to WriteLn.  This is because WriteLn must parse both strings
  and variables before it can write them.  Each call to the procedure
  carries the baggage of the parsing routines.

  WryteLn is a shell procedure for WriteLn.

  By having only one call to WriteLn in an entire program and calling
  it through a shell procedure, the program will trade some speed for
  code size -- but if speed is really critical, you should be using
  Object Professional's FastWrite procedures instead.

  Multiple variables can still be passed by concatenating them:
  WryteLn ('The time is now: ' + TimeStr + '.');
}

BEGIN
  WriteLn (S);
END;

{ ========================================================================= }
{ Initialization ========================================================== }

{ no initialization needed }
END.

{ ========================================================================= }
{ ========================================================================= }

VERSION HISTORY:
  9005.05
    Started with DgWryte, BlankLine, RulerLine, and FastFlushAbs.

{ ========================================================================= }

NOTES:

{ ========================================================================= }